(SETQ IBASE (ADD1 9.)) 


(DEFPROP ALLFNS 
 (NIL FOR POWER FOO MAX TRY1 TRY COLLAPSE STAA ST SEE TRY3 TRY2 MAKE ADJ1 ADJOIN GRUB) 
VALUE)

(DEFPROP FOR 
 (LAMBDA(M N FN)
  (PROG (X Y Z A B) (SETQ X M) A (PRINT (FN X)) (COND ((EQUAL X N) (RETURN NIL))) (SETQ X (ADD1 X)) (GO A))) 
EXPR)

(DEFPROP POWER 
 (LAMBDA (X Y) (COND ((EQUAL Y 0.) 1.) (T (TIMES X (POWER X (SUB1 Y)))))) 
EXPR)

(DEFPROP FOO 
 (LAMBDA (X) (TRY2 (SUB1 (POWER 3. X)))) 
EXPR)

(DEFPROP MAX 
 (LAMBDA (X Y) (COND ((LESSP X Y) Y) (T X))) 
EXPR)

(DEFPROP TRY1 
 (LAMBDA(M MAX T2 T3 NS)
  (COND ((EQUAL M 1.) (LIST T2 T3 MAX NS))
	((EQUAL 0. (REMAINDER M 2.)) (TRY1 (QUOTIENT M 2.) MAX (ADD1 T2) T3 NS))
	(T (TRY1 (ADD1 (TIMES 3. M)) (MAX MAX (ADD1 (TIMES 3. M))) T2 (ADD1 T3) (CONS M NS))))) 
EXPR)

(DEFPROP TRY 
 (LAMBDA (M) (TRY1 M 0. 0. 0. NIL)) 
EXPR)

(DEFPROP COLLAPSE 
 (LAMBDA (U) (COND ((ATOM U) U) ((NULL (CDR U)) (COLLAPSE (CAR U))) (T (MAPCAR (FUNCTION COLLAPSE) U)))) 
EXPR)

(DEFPROP STAA 
 (LAMBDA (X) (COND ((EQUAL 0. (REMAINDER X 2.)) (STAA (QUOTIENT X 2.))) (T X))) 
EXPR)

(DEFPROP ST 
 (LAMBDA (X) (STAA (ADD1 (TIMES 3. X)))) 
EXPR)

(DEFPROP SEE 
 (LAMBDA (N) (GRUB (QUOTE (1.)) 3. N)) 
EXPR)

(DEFPROP TRY3 
 (LAMBDA(M L)
  (COND ((EQUAL M 1.) L)
	((EQUAL 0. (REMAINDER M 2.)) (TRY3 (QUOTIENT M 2.) L))
	(T (TRY3 (ADD1 (TIMES 3. M)) (CONS M L))))) 
EXPR)

(DEFPROP TRY2 
 (LAMBDA (M) (TRY3 M NIL)) 
EXPR)

(DEFPROP MAKE 
 (LAMBDA (L) (COND ((NULL (CDR L)) L) (T (LIST (CAR L) (MAKE (CDR L)))))) 
EXPR)

(DEFPROP ADJ1 
 (LAMBDA(L TREEL)
  (COND ((NULL TREEL) (LIST (MAKE L)))
	((NULL L) TREEL)
	((EQUAL (CAR L) (CAAR TREEL)) (CONS (ADJOIN L (CAR TREEL)) (CDR TREEL)))
	(T (CONS (CAR TREEL) (ADJ1 L (CDR TREEL)))))) 
EXPR)

(DEFPROP ADJOIN 
 (LAMBDA(L TREE)
  (COND ((NULL L) TREE) ((EQUAL (CAR L) (CAR TREE)) (CONS (CAR TREE) (ADJ1 (CDR L) (CDR TREE)))))) 
EXPR)

(DEFPROP GRUB 
 (LAMBDA (TREE M N) (COND ((LESSP M N) (GRUB (ADJOIN (CONS 1. (TRY2 M)) TREE) (PLUS 2. M) N)) (T TREE))) 
EXPR)